home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / mg.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-02-27  |  24.5 KB  |  1,373 lines
  1. /*    mg.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Sam sat on the ground and put his head in his hands.  'I wish I had never
  12.  * come here, and I don't want to see no more magic,' he said, and fell silent."
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. /* Omit -- it causes too much grief on mixed systems.
  19. #ifdef I_UNISTD
  20. # include <unistd.h>
  21. #endif
  22. */
  23.  
  24. /*
  25.  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  26.  */
  27.  
  28. struct magic_state {
  29.     SV* mgs_sv;
  30.     U32 mgs_flags;
  31. };
  32. typedef struct magic_state MGS;
  33.  
  34. static void restore_magic _((void *p));
  35.  
  36. static MGS *
  37. save_magic(sv)
  38. SV* sv;
  39. {
  40.     MGS* mgs;
  41.  
  42.     assert(SvMAGICAL(sv));
  43.  
  44.     mgs = (MGS*)safemalloc(sizeof(MGS));
  45.     mgs->mgs_sv = sv;
  46.     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
  47.     SAVEDESTRUCTOR(restore_magic, mgs);
  48.  
  49.     SvMAGICAL_off(sv);
  50.     SvREADONLY_off(sv);
  51.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  52.  
  53.     return mgs;
  54. }
  55.  
  56. static void
  57. restore_magic(p)
  58. void* p;
  59. {
  60.     MGS *mgs = (MGS*)p;
  61.     SV* sv = mgs->mgs_sv;
  62.  
  63.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
  64.     {
  65.     if (mgs->mgs_flags)
  66.         SvFLAGS(sv) |= mgs->mgs_flags;
  67.     else
  68.         mg_magical(sv);
  69.     if (SvGMAGICAL(sv))
  70.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  71.     }
  72.  
  73.     Safefree(mgs);
  74. }
  75.  
  76.  
  77. void
  78. mg_magical(sv)
  79. SV* sv;
  80. {
  81.     MAGIC* mg;
  82.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  83.     MGVTBL* vtbl = mg->mg_virtual;
  84.     if (vtbl) {
  85.         if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
  86.         SvGMAGICAL_on(sv);
  87.         if (vtbl->svt_set)
  88.         SvSMAGICAL_on(sv);
  89.         if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
  90.         SvRMAGICAL_on(sv);
  91.     }
  92.     }
  93. }
  94.  
  95. int
  96. mg_get(sv)
  97. SV* sv;
  98. {
  99.     MGS* mgs;
  100.     MAGIC* mg;
  101.     MAGIC** mgp;
  102.  
  103.     ENTER;
  104.     mgs = save_magic(sv);
  105.  
  106.     mgp = &SvMAGIC(sv);
  107.     while ((mg = *mgp) != 0) {
  108.     MGVTBL* vtbl = mg->mg_virtual;
  109.     if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
  110.         (*vtbl->svt_get)(sv, mg);
  111.         /* Ignore this magic if it's been deleted */
  112.         if (*mgp == mg && (mg->mg_flags & MGf_GSKIP))
  113.         mgs->mgs_flags = 0;
  114.     }
  115.     /* Advance to next magic (complicated by possible deletion) */
  116.     if (*mgp == mg)
  117.         mgp = &mg->mg_moremagic;
  118.     }
  119.  
  120.     LEAVE;
  121.     return 0;
  122. }
  123.  
  124. int
  125. mg_set(sv)
  126. SV* sv;
  127. {
  128.     MGS* mgs;
  129.     MAGIC* mg;
  130.     MAGIC* nextmg;
  131.  
  132.     ENTER;
  133.     mgs = save_magic(sv);
  134.  
  135.     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
  136.     MGVTBL* vtbl = mg->mg_virtual;
  137.     nextmg = mg->mg_moremagic;    /* it may delete itself */
  138.     if (mg->mg_flags & MGf_GSKIP) {
  139.         mg->mg_flags &= ~MGf_GSKIP;    /* setting requires another read */
  140.         mgs->mgs_flags = 0;
  141.     }
  142.     if (vtbl && vtbl->svt_set)
  143.         (*vtbl->svt_set)(sv, mg);
  144.     }
  145.  
  146.     LEAVE;
  147.     return 0;
  148. }
  149.  
  150. U32
  151. mg_len(sv)
  152. SV* sv;
  153. {
  154.     MAGIC* mg;
  155.     char *junk;
  156.     STRLEN len;
  157.  
  158.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  159.     MGVTBL* vtbl = mg->mg_virtual;
  160.     if (vtbl && vtbl->svt_len) {
  161.         ENTER;
  162.         save_magic(sv);
  163.         /* omit MGf_GSKIP -- not changed here */
  164.         len = (*vtbl->svt_len)(sv, mg);
  165.         LEAVE;
  166.         return len;
  167.     }
  168.     }
  169.  
  170.     junk = SvPV(sv, len);
  171.     return len;
  172. }
  173.  
  174. int
  175. mg_clear(sv)
  176. SV* sv;
  177. {
  178.     MAGIC* mg;
  179.  
  180.     ENTER;
  181.     save_magic(sv);
  182.  
  183.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  184.     MGVTBL* vtbl = mg->mg_virtual;
  185.     /* omit GSKIP -- never set here */
  186.     
  187.     if (vtbl && vtbl->svt_clear)
  188.         (*vtbl->svt_clear)(sv, mg);
  189.     }
  190.  
  191.     LEAVE;
  192.     return 0;
  193. }
  194.  
  195. MAGIC*
  196. mg_find(sv, type)
  197. SV* sv;
  198. int type;
  199. {
  200.     MAGIC* mg;
  201.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  202.     if (mg->mg_type == type)
  203.         return mg;
  204.     }
  205.     return 0;
  206. }
  207.  
  208. int
  209. mg_copy(sv, nsv, key, klen)
  210. SV* sv;
  211. SV* nsv;
  212. char *key;
  213. STRLEN klen;
  214. {
  215.     int count = 0;
  216.     MAGIC* mg;
  217.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  218.     if (isUPPER(mg->mg_type)) {
  219.         sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
  220.         count++;
  221.     }
  222.     }
  223.     return count;
  224. }
  225.  
  226. int
  227. mg_free(sv)
  228. SV* sv;
  229. {
  230.     MAGIC* mg;
  231.     MAGIC* moremagic;
  232.     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
  233.     MGVTBL* vtbl = mg->mg_virtual;
  234.     moremagic = mg->mg_moremagic;
  235.     if (vtbl && vtbl->svt_free)
  236.         (*vtbl->svt_free)(sv, mg);
  237.     if (mg->mg_ptr && mg->mg_type != 'g')
  238.         Safefree(mg->mg_ptr);
  239.     if (mg->mg_flags & MGf_REFCOUNTED)
  240.         SvREFCNT_dec(mg->mg_obj);
  241.     Safefree(mg);
  242.     }
  243.     SvMAGIC(sv) = 0;
  244.     return 0;
  245. }
  246.  
  247. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  248. #include <signal.h>
  249. #endif
  250.  
  251. U32
  252. magic_len(sv, mg)
  253. SV *sv;
  254. MAGIC *mg;
  255. {
  256.     register I32 paren;
  257.     register char *s;
  258.     register I32 i;
  259.     char *t;
  260.  
  261.     switch (*mg->mg_ptr) {
  262.     case '1': case '2': case '3': case '4':
  263.     case '5': case '6': case '7': case '8': case '9': case '&':
  264.     if (curpm) {
  265.         paren = atoi(mg->mg_ptr);
  266.       getparen:
  267.         if (curpm->op_pmregexp &&
  268.           paren <= curpm->op_pmregexp->nparens &&
  269.           (s = curpm->op_pmregexp->startp[paren]) &&
  270.           (t = curpm->op_pmregexp->endp[paren]) ) {
  271.         i = t - s;
  272.         if (i >= 0)
  273.             return i;
  274.         }
  275.     }
  276.     return 0;
  277.     break;
  278.     case '+':
  279.     if (curpm) {
  280.         paren = curpm->op_pmregexp->lastparen;
  281.         if (!paren)
  282.         return 0;
  283.         goto getparen;
  284.     }
  285.     return 0;
  286.     break;
  287.     case '`':
  288.     if (curpm) {
  289.         if (curpm->op_pmregexp &&
  290.           (s = curpm->op_pmregexp->subbeg) ) {
  291.         i = curpm->op_pmregexp->startp[0] - s;
  292.         if (i >= 0)
  293.             return i;
  294.         }
  295.     }
  296.     return 0;
  297.     case '\'':
  298.     if (curpm) {
  299.         if (curpm->op_pmregexp &&
  300.           (s = curpm->op_pmregexp->endp[0]) ) {
  301.         return (STRLEN) (curpm->op_pmregexp->subend - s);
  302.         }
  303.     }
  304.     return 0;
  305.     case ',':
  306.     return (STRLEN)ofslen;
  307.     case '\\':
  308.     return (STRLEN)orslen;
  309.     }
  310.     magic_get(sv,mg);
  311.     if (!SvPOK(sv) && SvNIOK(sv))
  312.     sv_2pv(sv, &na);
  313.     if (SvPOK(sv))
  314.     return SvCUR(sv);
  315.     return 0;
  316. }
  317.  
  318. int
  319. magic_get(sv, mg)
  320. SV *sv;
  321. MAGIC *mg;
  322. {
  323.     register I32 paren;
  324.     register char *s;
  325.     register I32 i;
  326.     char *t;
  327.  
  328.     switch (*mg->mg_ptr) {
  329.     case '\001':        /* ^A */
  330.     sv_setsv(sv, bodytarget);
  331.     break;
  332.     case '\004':        /* ^D */
  333.     sv_setiv(sv,(I32)(debug & 32767));
  334.     break;
  335.     case '\006':        /* ^F */
  336.     sv_setiv(sv,(I32)maxsysfd);
  337.     break;
  338.     case '\010':        /* ^H */
  339.     sv_setiv(sv,(I32)hints);
  340.     break;
  341.     case '\t':            /* ^I */
  342.     if (inplace)
  343.         sv_setpv(sv, inplace);
  344.     else
  345.         sv_setsv(sv,&sv_undef);
  346.     break;
  347.     case '\020':        /* ^P */
  348.     sv_setiv(sv,(I32)perldb);
  349.     break;
  350.     case '\024':        /* ^T */
  351.     sv_setiv(sv,(I32)basetime);
  352.     break;
  353.     case '\027':        /* ^W */
  354.     sv_setiv(sv,(I32)dowarn);
  355.     break;
  356.     case '1': case '2': case '3': case '4':
  357.     case '5': case '6': case '7': case '8': case '9': case '&':
  358.     if (curpm) {
  359.         paren = atoi(GvENAME(mg->mg_obj));
  360.       getparen:
  361.         if (curpm->op_pmregexp &&
  362.           paren <= curpm->op_pmregexp->nparens &&
  363.           (s = curpm->op_pmregexp->startp[paren]) &&
  364.           (t = curpm->op_pmregexp->endp[paren]) ) {
  365.         i = t - s;
  366.         if (i >= 0) {
  367.             MAGIC *tmg;
  368.             sv_setpvn(sv,s,i);
  369.             if (tainting && (tmg = mg_find(sv,'t')))
  370.             tmg->mg_len = 0;    /* guarantee $1 untainted */
  371.             break;
  372.         }
  373.         }
  374.     }
  375.     sv_setsv(sv,&sv_undef);
  376.     break;
  377.     case '+':
  378.     if (curpm) {
  379.         paren = curpm->op_pmregexp->lastparen;
  380.         if (paren)
  381.         goto getparen;
  382.     }
  383.     sv_setsv(sv,&sv_undef);
  384.     break;
  385.     case '`':
  386.     if (curpm) {
  387.         if (curpm->op_pmregexp &&
  388.           (s = curpm->op_pmregexp->subbeg) ) {
  389.         i = curpm->op_pmregexp->startp[0] - s;
  390.         if (i >= 0) {
  391.             sv_setpvn(sv,s,i);
  392.             break;
  393.         }
  394.         }
  395.     }
  396.     sv_setsv(sv,&sv_undef);
  397.     break;
  398.     case '\'':
  399.     if (curpm) {
  400.         if (curpm->op_pmregexp &&
  401.           (s = curpm->op_pmregexp->endp[0]) ) {
  402.         sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
  403.         break;
  404.         }
  405.     }
  406.     sv_setsv(sv,&sv_undef);
  407.     break;
  408.     case '.':
  409. #ifndef lint
  410.     if (GvIO(last_in_gv)) {
  411.         sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
  412.     }
  413. #endif
  414.     break;
  415.     case '?':
  416.     sv_setiv(sv,(I32)statusvalue);
  417.     break;
  418.     case '^':
  419.     s = IoTOP_NAME(GvIOp(defoutgv));
  420.     if (s)
  421.         sv_setpv(sv,s);
  422.     else {
  423.         sv_setpv(sv,GvENAME(defoutgv));
  424.         sv_catpv(sv,"_TOP");
  425.     }
  426.     break;
  427.     case '~':
  428.     s = IoFMT_NAME(GvIOp(defoutgv));
  429.     if (!s)
  430.         s = GvENAME(defoutgv);
  431.     sv_setpv(sv,s);
  432.     break;
  433. #ifndef lint
  434.     case '=':
  435.     sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
  436.     break;
  437.     case '-':
  438.     sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
  439.     break;
  440.     case '%':
  441.     sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
  442.     break;
  443. #endif
  444.     case ':':
  445.     break;
  446.     case '/':
  447.     break;
  448.     case '[':
  449.     sv_setiv(sv,(I32)curcop->cop_arybase);
  450.     break;
  451.     case '|':
  452.     sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
  453.     break;
  454.     case ',':
  455.     sv_setpvn(sv,ofs,ofslen);
  456.     break;
  457.     case '\\':
  458.     sv_setpvn(sv,ors,orslen);
  459.     break;
  460.     case '#':
  461.     sv_setpv(sv,ofmt);
  462.     break;
  463.     case '!':
  464. #ifdef VMS
  465.     sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
  466. #else
  467.     sv_setnv(sv,(double)errno);
  468. #endif
  469.     sv_setpv(sv, errno ? Strerror(errno) : "");
  470.     SvNOK_on(sv);    /* what a wonderful hack! */
  471.     break;
  472.     case '<':
  473.     sv_setiv(sv,(I32)uid);
  474.     break;
  475.     case '>':
  476.     sv_setiv(sv,(I32)euid);
  477.     break;
  478.     case '(':
  479.     s = buf;
  480.     (void)sprintf(s,"%d",(int)gid);
  481.     goto add_groups;
  482.     case ')':
  483.     s = buf;
  484.     (void)sprintf(s,"%d",(int)egid);
  485.       add_groups:
  486.     while (*s) s++;
  487. #ifdef HAS_GETGROUPS
  488. #ifndef NGROUPS
  489. #define NGROUPS 32
  490. #endif
  491.     {
  492.         Groups_t gary[NGROUPS];
  493.  
  494.         i = getgroups(NGROUPS,gary);
  495.         while (--i >= 0) {
  496.         (void)sprintf(s," %ld", (long)gary[i]);
  497.         while (*s) s++;
  498.         }
  499.     }
  500. #endif
  501.     sv_setpv(sv,buf);
  502.     break;
  503.     case '*':
  504.     break;
  505.     case '0':
  506.     break;
  507.     }
  508.     return 0;
  509. }
  510.  
  511. int
  512. magic_getuvar(sv, mg)
  513. SV *sv;
  514. MAGIC *mg;
  515. {
  516.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  517.  
  518.     if (uf && uf->uf_val)
  519.     (*uf->uf_val)(uf->uf_index, sv);
  520.     return 0;
  521. }
  522.  
  523. int
  524. magic_setenv(sv,mg)
  525. SV* sv;
  526. MAGIC* mg;
  527. {
  528.     register char *s;
  529.     STRLEN len;
  530.     I32 i;
  531.     s = SvPV(sv,len);
  532.     my_setenv(mg->mg_ptr,s);
  533. #ifdef DYNAMIC_ENV_FETCH
  534.      /* We just undefd an environment var.  Is a replacement */
  535.      /* waiting in the wings? */
  536.     if (!len) {
  537.     SV **envsvp;
  538.     if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE))
  539.         s = SvPV(*envsvp,len);
  540.     }
  541. #endif
  542.                 /* And you'll never guess what the dog had */
  543.                 /*   in its mouth... */
  544.     if (tainting) {
  545.     if (s && strEQ(mg->mg_ptr,"PATH")) {
  546.         char *strend = s + len;
  547.  
  548.         while (s < strend) {
  549.         s = cpytill(tokenbuf,s,strend,':',&i);
  550.         s++;
  551.         if (*tokenbuf != '/'
  552.           || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  553.             MgTAINTEDDIR_on(mg);
  554.         }
  555.     }
  556.     }
  557.     return 0;
  558. }
  559.  
  560. int
  561. magic_clearenv(sv,mg)
  562. SV* sv;
  563. MAGIC* mg;
  564. {
  565.     my_setenv(mg->mg_ptr,Nullch);
  566.     return 0;
  567. }
  568.  
  569. #ifdef HAS_SIGACTION
  570. /* set up reliable signal() clone */
  571.  
  572. typedef void (*Sigfunc) _((int));
  573.  
  574. static
  575. Sigfunc rsignal(signo,handler)
  576. int signo;
  577. Sigfunc handler;
  578. {
  579.     struct sigaction act,oact;
  580.     
  581.     act.sa_handler = handler;
  582.     sigemptyset(&act.sa_mask);
  583.     act.sa_flags = 0;
  584. #ifdef SIGALRM    
  585.     if (signo == SIGALRM) {
  586. #else
  587.     if (0) {
  588. #endif        
  589. #ifdef SA_INTERRUPT
  590.     act.sa_flags |= SA_INTERRUPT;    /* SunOS */
  591. #endif    
  592.     } else {
  593. #ifdef SA_RESTART
  594.     act.sa_flags |= SA_RESTART;    /* SVR4, 4.3+BSD */
  595. #endif
  596.     }
  597.     if (sigaction(signo, &act, &oact) < 0)
  598.         return(SIG_ERR);
  599.     else
  600.         return(oact.sa_handler);
  601. }
  602.  
  603. #else
  604.  
  605. /* ah well, so much for reliability */
  606.  
  607. #define rsignal(x,y) signal(x,y)
  608.  
  609. #endif
  610.  
  611.  
  612. int
  613. magic_setsig(sv,mg)
  614. SV* sv;
  615. MAGIC* mg;
  616. {
  617.     register char *s;
  618.     I32 i;
  619.     SV** svp;
  620.  
  621.     s = mg->mg_ptr;
  622.     if (*s == '_') {
  623.     if (strEQ(s,"__DIE__"))
  624.         svp = &diehook;
  625.     else if (strEQ(s,"__WARN__"))
  626.         svp = &warnhook;
  627.     else if (strEQ(s,"__PARSE__"))
  628.         svp = &parsehook;
  629.     else
  630.         croak("No such hook: %s", s);
  631.     i = 0;
  632.     if (*svp) {
  633.         SvREFCNT_dec(*svp);
  634.         *svp = 0;
  635.     }
  636.     }
  637.     else {
  638.     i = whichsig(s);    /* ...no, a brick */
  639.     if (!i) {
  640.         if (dowarn || strEQ(s,"ALARM"))
  641.         warn("No such signal: SIG%s", s);
  642.         return 0;
  643.     }
  644.     }
  645.     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
  646.     if (i)
  647.         (void)rsignal(i,sighandler);
  648.     else
  649.         *svp = SvREFCNT_inc(sv);
  650.     return 0;
  651.     }
  652.     s = SvPV_force(sv,na);
  653.     if (strEQ(s,"IGNORE")) {
  654.     if (i)
  655.         (void)rsignal(i,SIG_IGN);
  656.     else
  657.         *svp = 0;
  658.     }
  659.     else if (strEQ(s,"DEFAULT") || !*s) {
  660.     if (i)
  661.         (void)rsignal(i,SIG_DFL);
  662.     else
  663.         *svp = 0;
  664.     }
  665.     else {
  666.     if (!strchr(s,':') && !strchr(s,'\'')) {
  667.         sprintf(tokenbuf, "main::%s",s);
  668.         sv_setpv(sv,tokenbuf);
  669.     }
  670.     if (i)
  671.         (void)rsignal(i,sighandler);
  672.     else
  673.         *svp = SvREFCNT_inc(sv);
  674.     }
  675.     return 0;
  676. }
  677.  
  678. int
  679. magic_setisa(sv,mg)
  680. SV* sv;
  681. MAGIC* mg;
  682. {
  683.     sub_generation++;
  684.     return 0;
  685. }
  686.  
  687. #ifdef OVERLOAD
  688.  
  689. int
  690. magic_setamagic(sv,mg)
  691. SV* sv;
  692. MAGIC* mg;
  693. {
  694.     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
  695.     amagic_generation++;
  696.  
  697.     return 0;
  698. }
  699. #endif /* OVERLOAD */
  700.  
  701. static int
  702. magic_methpack(sv,mg,meth)
  703. SV* sv;
  704. MAGIC* mg;
  705. char *meth;
  706. {
  707.     dSP;
  708.  
  709.     ENTER;
  710.     SAVETMPS;
  711.     PUSHMARK(sp);
  712.     EXTEND(sp, 2);
  713.     PUSHs(mg->mg_obj);
  714.     if (mg->mg_ptr)
  715.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  716.     else if (mg->mg_type == 'p')
  717.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  718.     PUTBACK;
  719.  
  720.     if (perl_call_method(meth, G_SCALAR))
  721.     sv_setsv(sv, *stack_sp--);
  722.  
  723.     FREETMPS;
  724.     LEAVE;
  725.     return 0;
  726. }
  727.  
  728. int
  729. magic_getpack(sv,mg)
  730. SV* sv;
  731. MAGIC* mg;
  732. {
  733.     magic_methpack(sv,mg,"FETCH");
  734.     if (mg->mg_ptr)
  735.     mg->mg_flags |= MGf_GSKIP;
  736.     return 0;
  737. }
  738.  
  739. int
  740. magic_setpack(sv,mg)
  741. SV* sv;
  742. MAGIC* mg;
  743. {
  744.     dSP;
  745.  
  746.     PUSHMARK(sp);
  747.     EXTEND(sp, 3);
  748.     PUSHs(mg->mg_obj);
  749.     if (mg->mg_ptr)
  750.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  751.     else if (mg->mg_type == 'p')
  752.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  753.     PUSHs(sv);
  754.     PUTBACK;
  755.  
  756.     perl_call_method("STORE", G_SCALAR|G_DISCARD);
  757.  
  758.     return 0;
  759. }
  760.  
  761. int
  762. magic_clearpack(sv,mg)
  763. SV* sv;
  764. MAGIC* mg;
  765. {
  766.     return magic_methpack(sv,mg,"DELETE");
  767. }
  768.  
  769. int magic_wipepack(sv,mg)
  770. SV* sv;
  771. MAGIC* mg;
  772. {
  773.     dSP;
  774.  
  775.     PUSHMARK(sp);
  776.     XPUSHs(mg->mg_obj);
  777.     PUTBACK;
  778.  
  779.     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
  780.  
  781.     return 0;
  782. }
  783.  
  784. int
  785. magic_nextpack(sv,mg,key)
  786. SV* sv;
  787. MAGIC* mg;
  788. SV* key;
  789. {
  790.     dSP;
  791.     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
  792.  
  793.     ENTER;
  794.     SAVETMPS;
  795.     PUSHMARK(sp);
  796.     EXTEND(sp, 2);
  797.     PUSHs(mg->mg_obj);
  798.     if (SvOK(key))
  799.     PUSHs(key);
  800.     PUTBACK;
  801.  
  802.     if (perl_call_method(meth, G_SCALAR))
  803.     sv_setsv(key, *stack_sp--);
  804.  
  805.     FREETMPS;
  806.     LEAVE;
  807.     return 0;
  808. }
  809.  
  810. int
  811. magic_existspack(sv,mg)
  812. SV* sv;
  813. MAGIC* mg;
  814. {
  815.     return magic_methpack(sv,mg,"EXISTS");
  816. } 
  817.  
  818. int
  819. magic_setdbline(sv,mg)
  820. SV* sv;
  821. MAGIC* mg;
  822. {
  823.     OP *o;
  824.     I32 i;
  825.     GV* gv;
  826.     SV** svp;
  827.  
  828.     gv = DBline;
  829.     i = SvTRUE(sv);
  830.     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
  831.     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
  832.     o->op_private = i;
  833.     else
  834.     warn("Can't break at that line\n");
  835.     return 0;
  836. }
  837.  
  838. int
  839. magic_getarylen(sv,mg)
  840. SV* sv;
  841. MAGIC* mg;
  842. {
  843.     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
  844.     return 0;
  845. }
  846.  
  847. int
  848. magic_setarylen(sv,mg)
  849. SV* sv;
  850. MAGIC* mg;
  851. {
  852.     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
  853.     return 0;
  854. }
  855.  
  856. int
  857. magic_getpos(sv,mg)
  858. SV* sv;
  859. MAGIC* mg;
  860. {
  861.     SV* lsv = LvTARG(sv);
  862.     
  863.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
  864.     mg = mg_find(lsv, 'g');
  865.     if (mg && mg->mg_len >= 0) {
  866.         sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
  867.         return 0;
  868.     }
  869.     }
  870.     (void)SvOK_off(sv);
  871.     return 0;
  872. }
  873.  
  874. int
  875. magic_setpos(sv,mg)
  876. SV* sv;
  877. MAGIC* mg;
  878. {
  879.     SV* lsv = LvTARG(sv);
  880.     SSize_t pos;
  881.     STRLEN len;
  882.  
  883.     mg = 0;
  884.     
  885.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
  886.     mg = mg_find(lsv, 'g');
  887.     if (!mg) {
  888.     if (!SvOK(sv))
  889.         return 0;
  890.     sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
  891.     mg = mg_find(lsv, 'g');
  892.     }
  893.     else if (!SvOK(sv)) {
  894.     mg->mg_len = -1;
  895.     return 0;
  896.     }
  897.     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
  898.  
  899.     pos = SvIV(sv) - curcop->cop_arybase;
  900.     if (pos < 0) {
  901.     pos += len;
  902.     if (pos < 0)
  903.         pos = 0;
  904.     }
  905.     else if (pos > len)
  906.     pos = len;
  907.     mg->mg_len = pos;
  908.  
  909.     return 0;
  910. }
  911.  
  912. int
  913. magic_getglob(sv,mg)
  914. SV* sv;
  915. MAGIC* mg;
  916. {
  917.     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
  918.     return 0;
  919. }
  920.  
  921. int
  922. magic_setglob(sv,mg)
  923. SV* sv;
  924. MAGIC* mg;
  925. {
  926.     register char *s;
  927.     GV* gv;
  928.  
  929.     if (!SvOK(sv))
  930.     return 0;
  931.     s = SvPV(sv, na);
  932.     if (*s == '*' && s[1])
  933.     s++;
  934.     gv = gv_fetchpv(s,TRUE, SVt_PVGV);
  935.     if (sv == (SV*)gv)
  936.     return 0;
  937.     if (GvGP(sv))
  938.     gp_free(sv);
  939.     GvGP(sv) = gp_ref(GvGP(gv));
  940.     if (!GvAV(gv))
  941.     gv_AVadd(gv);
  942.     if (!GvHV(gv))
  943.     gv_HVadd(gv);
  944.     if (!GvIOp(gv))
  945.     GvIOp(gv) = newIO();
  946.     return 0;
  947. }
  948.  
  949. int
  950. magic_setsubstr(sv,mg)
  951. SV* sv;
  952. MAGIC* mg;
  953. {
  954.     STRLEN len;
  955.     char *tmps = SvPV(sv,len);
  956.     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
  957.     return 0;
  958. }
  959.  
  960. int
  961. magic_gettaint(sv,mg)
  962. SV* sv;
  963. MAGIC* mg;
  964. {
  965.     if (mg->mg_len & 1)
  966.     tainted = TRUE;
  967.     else if (mg->mg_len & 2 && mg->mg_obj == sv)    /* kludge */
  968.     tainted = TRUE;
  969.     return 0;
  970. }
  971.  
  972. int
  973. magic_settaint(sv,mg)
  974. SV* sv;
  975. MAGIC* mg;
  976. {
  977.     if (localizing) {
  978.     if (localizing == 1)
  979.         mg->mg_len <<= 1;
  980.     else
  981.         mg->mg_len >>= 1;
  982.     }
  983.     else if (tainted)
  984.     mg->mg_len |= 1;
  985.     else
  986.     mg->mg_len &= ~1;
  987.     return 0;
  988. }
  989.  
  990. int
  991. magic_setvec(sv,mg)
  992. SV* sv;
  993. MAGIC* mg;
  994. {
  995.     do_vecset(sv);    /* XXX slurp this routine */
  996.     return 0;
  997. }
  998.  
  999. int
  1000. magic_setmglob(sv,mg)
  1001. SV* sv;
  1002. MAGIC* mg;
  1003. {
  1004.     mg->mg_len = -1;
  1005.     SvSCREAM_off(sv);
  1006.     return 0;
  1007. }
  1008.  
  1009. int
  1010. magic_setbm(sv,mg)
  1011. SV* sv;
  1012. MAGIC* mg;
  1013. {
  1014.     sv_unmagic(sv, 'B');
  1015.     SvVALID_off(sv);
  1016.     return 0;
  1017. }
  1018.  
  1019. int
  1020. magic_setuvar(sv,mg)
  1021. SV* sv;
  1022. MAGIC* mg;
  1023. {
  1024.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  1025.  
  1026.     if (uf && uf->uf_set)
  1027.     (*uf->uf_set)(uf->uf_index, sv);
  1028.     return 0;
  1029. }
  1030.  
  1031. int
  1032. magic_set(sv,mg)
  1033. SV* sv;
  1034. MAGIC* mg;
  1035. {
  1036.     register char *s;
  1037.     I32 i;
  1038.     STRLEN len;
  1039.     switch (*mg->mg_ptr) {
  1040.     case '\001':    /* ^A */
  1041.     sv_setsv(bodytarget, sv);
  1042.     break;
  1043.     case '\004':    /* ^D */
  1044.     debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
  1045.     DEBUG_x(dump_all());
  1046.     break;
  1047.     case '\006':    /* ^F */
  1048.     maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1049.     break;
  1050.     case '\010':    /* ^H */
  1051.     hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1052.     break;
  1053.     case '\t':    /* ^I */
  1054.     if (inplace)
  1055.         Safefree(inplace);
  1056.     if (SvOK(sv))
  1057.         inplace = savepv(SvPV(sv,na));
  1058.     else
  1059.         inplace = Nullch;
  1060.     break;
  1061.     case '\020':    /* ^P */
  1062.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1063.     if (i != perldb) {
  1064.         if (perldb)
  1065.         oldlastpm = curpm;
  1066.         else
  1067.         curpm = oldlastpm;
  1068.     }
  1069.     perldb = i;
  1070.     break;
  1071.     case '\024':    /* ^T */
  1072.     basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1073.     break;
  1074.     case '\027':    /* ^W */
  1075.     dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1076.     break;
  1077.     case '.':
  1078.     if (localizing) {
  1079.         if (localizing == 1)
  1080.         save_sptr((SV**)&last_in_gv);
  1081.     }
  1082.     else if (SvOK(sv))
  1083.         IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
  1084.     break;
  1085.     case '^':
  1086.     Safefree(IoTOP_NAME(GvIOp(defoutgv)));
  1087.     IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1088.     IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1089.     break;
  1090.     case '~':
  1091.     Safefree(IoFMT_NAME(GvIOp(defoutgv)));
  1092.     IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1093.     IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1094.     break;
  1095.     case '=':
  1096.     IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1097.     break;
  1098.     case '-':
  1099.     IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1100.     if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
  1101.         IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
  1102.     break;
  1103.     case '%':
  1104.     IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1105.     break;
  1106.     case '|':
  1107.     IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
  1108.     if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
  1109.         IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
  1110.     }
  1111.     break;
  1112.     case '*':
  1113.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1114.     multiline = (i != 0);
  1115.     break;
  1116.     case '/':
  1117.     SvREFCNT_dec(nrs);
  1118.     nrs = newSVsv(sv);
  1119.     SvREFCNT_dec(rs);
  1120.     rs = SvREFCNT_inc(nrs);
  1121.     break;
  1122.     case '\\':
  1123.     if (ors)
  1124.         Safefree(ors);
  1125.     ors = savepv(SvPV(sv,orslen));
  1126.     break;
  1127.     case ',':
  1128.     if (ofs)
  1129.         Safefree(ofs);
  1130.     ofs = savepv(SvPV(sv, ofslen));
  1131.     break;
  1132.     case '#':
  1133.     if (ofmt)
  1134.         Safefree(ofmt);
  1135.     ofmt = savepv(SvPV(sv,na));
  1136.     break;
  1137.     case '[':
  1138.     compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1139.     break;
  1140.     case '?':
  1141.     statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1142.     break;
  1143.     case '!':
  1144.     SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);        /* will anyone ever use this? */
  1145.     break;
  1146.     case '<':
  1147.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1148.     if (delaymagic) {
  1149.         delaymagic |= DM_RUID;
  1150.         break;                /* don't do magic till later */
  1151.     }
  1152. #ifdef HAS_SETRUID
  1153.     (void)setruid((Uid_t)uid);
  1154. #else
  1155. #ifdef HAS_SETREUID
  1156.     (void)setreuid((Uid_t)uid, (Uid_t)-1);
  1157. #else
  1158. #ifdef HAS_SETRESUID
  1159.       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
  1160. #else
  1161.     if (uid == euid)        /* special case $< = $> */
  1162.         (void)setuid(uid);
  1163.     else {
  1164.         uid = (I32)getuid();
  1165.         croak("setruid() not implemented");
  1166.     }
  1167. #endif
  1168. #endif
  1169. #endif
  1170.     uid = (I32)getuid();
  1171.     tainting |= (uid && (euid != uid || egid != gid));
  1172.     break;
  1173.     case '>':
  1174.     euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1175.     if (delaymagic) {
  1176.         delaymagic |= DM_EUID;
  1177.         break;                /* don't do magic till later */
  1178.     }
  1179. #ifdef HAS_SETEUID
  1180.     (void)seteuid((Uid_t)euid);
  1181. #else
  1182. #ifdef HAS_SETREUID
  1183.     (void)setreuid((Uid_t)-1, (Uid_t)euid);
  1184. #else
  1185. #ifdef HAS_SETRESUID
  1186.     (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
  1187. #else
  1188.     if (euid == uid)        /* special case $> = $< */
  1189.         setuid(euid);
  1190.     else {
  1191.         euid = (I32)geteuid();
  1192.         croak("seteuid() not implemented");
  1193.     }
  1194. #endif
  1195. #endif
  1196. #endif
  1197.     euid = (I32)geteuid();
  1198.     tainting |= (uid && (euid != uid || egid != gid));
  1199.     break;
  1200.     case '(':
  1201.     gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1202.     if (delaymagic) {
  1203.         delaymagic |= DM_RGID;
  1204.         break;                /* don't do magic till later */
  1205.     }
  1206. #ifdef HAS_SETRGID
  1207.     (void)setrgid((Gid_t)gid);
  1208. #else
  1209. #ifdef HAS_SETREGID
  1210.     (void)setregid((Gid_t)gid, (Gid_t)-1);
  1211. #else
  1212. #ifdef HAS_SETRESGID
  1213.       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
  1214. #else
  1215.     if (gid == egid)            /* special case $( = $) */
  1216.         (void)setgid(gid);
  1217.     else {
  1218.         gid = (I32)getgid();
  1219.         croak("setrgid() not implemented");
  1220.     }
  1221. #endif
  1222. #endif
  1223. #endif
  1224.     gid = (I32)getgid();
  1225.     tainting |= (uid && (euid != uid || egid != gid));
  1226.     break;
  1227.     case ')':
  1228.     egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1229.     if (delaymagic) {
  1230.         delaymagic |= DM_EGID;
  1231.         break;                /* don't do magic till later */
  1232.     }
  1233. #ifdef HAS_SETEGID
  1234.     (void)setegid((Gid_t)egid);
  1235. #else
  1236. #ifdef HAS_SETREGID
  1237.     (void)setregid((Gid_t)-1, (Gid_t)egid);
  1238. #else
  1239. #ifdef HAS_SETRESGID
  1240.     (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
  1241. #else
  1242.     if (egid == gid)            /* special case $) = $( */
  1243.         (void)setgid(egid);
  1244.     else {
  1245.         egid = (I32)getegid();
  1246.         croak("setegid() not implemented");
  1247.     }
  1248. #endif
  1249. #endif
  1250. #endif
  1251.     egid = (I32)getegid();
  1252.     tainting |= (uid && (euid != uid || egid != gid));
  1253.     break;
  1254.     case ':':
  1255.     chopset = SvPV_force(sv,na);
  1256.     break;
  1257.     case '0':
  1258.     if (!origalen) {
  1259.         s = origargv[0];
  1260.         s += strlen(s);
  1261.         /* See if all the arguments are contiguous in memory */
  1262.         for (i = 1; i < origargc; i++) {
  1263.         if (origargv[i] == s + 1)
  1264.             s += strlen(++s);    /* this one is ok too */
  1265.         }
  1266.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  1267.         my_setenv("NoNeSuCh", Nullch);
  1268.                         /* force copy of environment */
  1269.         for (i = 0; origenviron[i]; i++)
  1270.             if (origenviron[i] == s + 1)
  1271.             s += strlen(++s);
  1272.         }
  1273.         origalen = s - origargv[0];
  1274.     }
  1275.     s = SvPV_force(sv,len);
  1276.     i = len;
  1277.     if (i >= origalen) {
  1278.         i = origalen;
  1279.         SvCUR_set(sv, i);
  1280.         *SvEND(sv) = '\0';
  1281.         Copy(s, origargv[0], i, char);
  1282.     }
  1283.     else {
  1284.         Copy(s, origargv[0], i, char);
  1285.         s = origargv[0]+i;
  1286.         *s++ = '\0';
  1287.         while (++i < origalen)
  1288.         *s++ = ' ';
  1289.         s = origargv[0]+i;
  1290.         for (i = 1; i < origargc; i++)
  1291.         origargv[i] = Nullch;
  1292.     }
  1293.     break;
  1294.     }
  1295.     return 0;
  1296. }
  1297.  
  1298. I32
  1299. whichsig(sig)
  1300. char *sig;
  1301. {
  1302.     register char **sigv;
  1303.  
  1304.     for (sigv = sig_name+1; *sigv; sigv++)
  1305.     if (strEQ(sig,*sigv))
  1306.         return sig_num[sigv - sig_name];
  1307. #ifdef SIGCLD
  1308.     if (strEQ(sig,"CHLD"))
  1309.     return SIGCLD;
  1310. #endif
  1311. #ifdef SIGCHLD
  1312.     if (strEQ(sig,"CLD"))
  1313.     return SIGCHLD;
  1314. #endif
  1315.     return 0;
  1316. }
  1317.  
  1318. Signal_t
  1319. sighandler(sig)
  1320. int sig;
  1321. {
  1322.     dSP;
  1323.     GV *gv;
  1324.     HV *st;
  1325.     SV *sv;
  1326.     CV *cv;
  1327.     AV *oldstack;
  1328.     char *signame; 
  1329.  
  1330. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  1331.     signal(sig, SIG_ACK);
  1332. #endif
  1333.  
  1334.     signame = sig_name[sig];
  1335.     cv = sv_2cv(*hv_fetch(GvHVn(siggv),signame,strlen(signame),
  1336.               TRUE),
  1337.         &st, &gv, TRUE);
  1338.     if (!cv || !CvROOT(cv) &&
  1339.     *signame == 'C' && instr(signame,"LD")) {
  1340.     
  1341.     if (signame[1] == 'H')
  1342.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
  1343.             &st, &gv, TRUE);
  1344.     else
  1345.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
  1346.             &st, &gv, TRUE);
  1347.     /* gag */
  1348.     }
  1349.     if (!cv || !CvROOT(cv)) {
  1350.     if (dowarn)
  1351.         warn("SIG%s handler \"%s\" not defined.\n",
  1352.         signame, GvENAME(gv) );
  1353.     return;
  1354.     }
  1355.  
  1356.     oldstack = stack;
  1357.     if (stack != signalstack)
  1358.     AvFILL(signalstack) = 0;
  1359.     SWITCHSTACK(stack, signalstack);
  1360.  
  1361.     sv = sv_newmortal();
  1362.     sv_setpv(sv,signame);
  1363.     PUSHMARK(sp);
  1364.     PUSHs(sv);
  1365.     PUTBACK;
  1366.  
  1367.     perl_call_sv((SV*)cv, G_DISCARD);
  1368.  
  1369.     SWITCHSTACK(signalstack, oldstack);
  1370.  
  1371.     return;
  1372. }
  1373.